perm filename MSSET.F4[NEW,LCS] blob sn#717316 filedate 1983-06-18 generic text, type T, neo UTF8
C MSSET.F4,GRCSHF,STORE,MOVE1,RHEQ,ADJX,COMBI,INSPT,LASTMV,FIB
C THIS ROUTINE CALLED BY MS - OR BY JUST.
	SUBROUTINE MSSET(NSTF)
	COMMON /XRN/RN(1) /PTR/KWDS(1) /LIMIT/LIMIT,ITEM
	1/RINP/P(250),RHY(250),NO(400) /WHICH/SIZ(3),WHICH(3)
	COMMON R2,JA,CENTR,J2,RJ3,R4,R5 /MEDIT/MEDIT,IGO
CC	COMMON/RINP/NSTF(500),NO(400) /MEDIT/MEDIT,IGO
CC	COMMON /SET/P(200),RHY(200),SIZ(3),WHICH(3)
	DATA SIZ/4.0,7.0,5.0/,WHICH/-0.200,-0.400,-0.300/
	IGO=0
C IGO=0 SUPPRESSES ALL BUT LAST DPYOUT
C	IF(IDEV.NE.5)GO TO 100
C	CALL TYPSTR
C	1 (' DO YOU REALLY WANT TO LINE UP EVERYTHING? (Y-N) ')
C101	FORMAT(1A1)
C	ACCEPT 101,K
C 	IF(K.NE.LYY)RETURN
100	GRACE=4./88.
C VALUE OF GRACE NOTE
C JA=0 UPON ARRIVAL HERE.
	CALL ORDER(ITEM)
C ORDER ALL ITEMS BY STAFF NUM.
        TOTSTF=NSTF*8-1
C       TOTSTF=TOTAL STAVES-1   STAFF COUNT BEGINS WITH 0.
	J=1
        RST=0
        N=0
	I=1
4       RRH=0
	NTRST=0
C FLAG FOR 1ST NOTE OR REST
	N=I-1
C RRH WILL HOLD RHY TOTAL OF STAFF 0
C I POINTS TO START OF CURRENT (UPPER) STAFF
        DO 1 K=J,ITEM
        L=KWDS(K)
        R2=RN(L+2)
        IF(R2.NE.RST)GO TO 1
        R1=RN(L+1)
        IF(R1.LE.2.0)GO TO 6
C FOUND NOTE OR REST
	IF(R1.NE.4.0)GO TO 7
	IF(RN(L).GT.3.0)GO TO 1
C FOUND BARLINE
	GO TO 6
8	L=1
C FOR BARLINE (.2*20 = 4 STEPS)
	IF(R1.GE.17.0)L=R1-15
	RH=WHICH(L)
	GO TO 3
7	IF(R1.LT.17.0)GO TO 1
C FOUND KSIG OR METER
6       R3=RN(L+3)
        RA=RN(L)
        IF(R1.EQ.2.0)GO TO 2
	IF(R1.GT.2.0)GO TO 8
        IF(RA.LT.7.0)GO TO 1
        RH=RN(L+9)
	IF(ABS(RH-GRACE).GT.0.01)GO TO 30
C SKIP IF NOT GRACE NOTE
	IF(RST.EQ.0.OR.NTRST.LT.0)GO TO 1
C NOW GRACE NOTE IS FIRST ON AN UPPER STAFF
	IF(R3.GE.P(1))CALL GRCSHF(R3,K)
C SKIP IF TO LEFT OF 1ST NOTE, STAFF 0
C GO SHIFT GRACE NOTES TO LEFT OF 1ST NOTE
        GO TO 1

2       IF(RA.LT.5.0)GO TO 1
        RH=RN(L+7)
30      IF(RH.LE.0)GO TO 1
	NTRST=-1
3       IF(NTRST.EQ.0)GO TO 1
C DON'T STORE BAR,METER,KSIG UNTIL AFTER 1ST NOTE OR REST
	N=N+1
        IF(RH.GT.0)RRH=RRH+RH
C ADD UP TOTAL RHYTHM
        CALL STORE(N,RH,R2,R3)
	J=K
1       CONTINUE
	IF(RRH.EQ.0)GO TO 5
C SKIP IF NO RHYTHMS ON THIS STAFF
        CALL RHEQ(RRH,RST)
CHECK IF RHYTHM OF THIS STAFF = TOTAL OF STAFF 0
        CALL MOVE1(I,N,RST)
C GO MOVE EVERYTHING TO EXACT RHYTHMIC POS
        IF(RST.EQ.0)I=N+1
C I POINTS TO START OF CURRENT STAFF
        IF(RST.GT.0)CALL COMBI(N,I,RST)
C GO COMBINE RHYTHMS - FIND SMALLEST VALUES
	TYPE 9,RST
9	FORMAT(' STAFF',1F3.0)
5       RST=RST+1
C GET READY FOR NEXT STAFF
        IF(RST.LE.TOTSTF)GO TO 4
C NO MORE STAVES?  NOW MOVE ALL TO PROPER POSITIONS.
	CALL ADJX
C ADJUST CLEFS, KSIGS, METERS
	R2=999.
	R4=2000.0
	R5=2200.0
C R4, R5 NEEDED IN GETPTS
	CALL GETPTS(1)
	CALL MOVIT(RN,NO,R4,R5,-2000.,0)
C MOVE ALL LEFT OVER (UP TO POS. 200) BACK TO PROPER POSITIONS.
	CALL LASTMV(I)
	END


	SUBROUTINE GRCSHF(R3,K)
C GRACE NOTE SHIFTER (IF 1ST IN AN UPPER STAFF)
        COMMON /XRN/RN(1) /RINP/P(250),RHY(250),NO(1)
	COMMON /LIMIT/LIMIT,ITEM
	COMMON R2,JA,CENTR,J2,RJ3,R4,R5 /PTR/KWDS(1)
	R4=R3
C FOR GETPTS
	DO 10 KK=K+1,ITEM
C LOOK FOR NEXT REAL NOTE OR REST
	R1=CODN(KK,L)
	IF(R1.GT.2.0)GO TO 10
	IF(ABS(RN(L+4))+20.0.GE.100.0)GO TO 10
C SKIP IF NEXT IS ANOTHER GRACE NOTE
	R3=RN(L+3)-R3
C DIFFERENCE IN POS. OF GRACE NOTE AND NEXT REAL NOTE
	GO TO 11
10	CONTINUE
C ERROR IF WE GET HERE WITHOUT JUMPING OUT OF LOOP
11	R5=R4+R3-.1
	CALL GETPTS(1)
	CALL MOVIT(RN,NO,R4,R5,P(1)-R5,0)
C MOVE GRACE NOTES TO LEFT OF 1ST NOTE, STAFF 0
	END

        SUBROUTINE STORE(N,RH,R2,R3)
	COMMON /RINP/P(250),RHY(250)
        P(N)=R3
        RHY(N)=RH
	IF(N.EQ.1.OR.R3.NE.P(N-1))RETURN
	N=N-1
3	TYPE 30,R3,RH,RHY(K),R2
30	FORMAT(' *** TWO RHYTHMS AT POS.= ',3F7.3,' STAFF =',F3.0)
	PAUSE
	END


        SUBROUTINE MOVE1(I,N,RST)
        COMMON /XRN/RN(1) /RINP/P(250),RHY(250),NO(1)
	COMMON R2,JA,CENTR,J2,RJ3,R4,R5

        IF(RST.NE.0)GO TO 1
C SET FOR 1ST STAFF (0)
        POS1=P(1)
C R4,R5 = POS. LIMITS TO LOOK IN
1	R4=0
	R5=1999.0
C R4, R5 NEEDED IN GETPTS
	R2=RST
	CALL GETPTS(1)
	CALL MOVIT(RN,NO,R4,R5,2000.,0)
C SHIFT ALL 2000 TO RIGHT. SHIFT BACK WHEN ALL DONE.
        POSX=POS1
        P(N+1)=200.0
C PUT END OF LINE VALUE IN NEXT POSITION SLOT.
        K=I
	NN=N+1
3       POSY=POSX+ABS(RHY(K)*20.0)
C POSITION OF NEXT RHYTHMIC POINT.
        CALL MOVIT(RN,NO,P(K)+2000.,P(K+1)+2000.,POSX,POSY)
C MOVE ALL FROM CURRENT POS TO LIMITS OF STAFF 0' RHYTHMS
	P(K)=POSX
C RESET POSITION OF THIS RHYTHM
2       POSX=POSY
	K=K+1
	IF(K.LE.NN)GO TO 3
C NOW ALL MOVED TO PROPER RHYTHMIC POSITIONS AND ALIGNED WITH STAFF 0.
	P(N+1)=0
	END

	
        SUBROUTINE RHEQ(RRH,RST)
	IF(RST.NE.0)GO TO 1
	RHTOT=RRH
	RETURN
1	IF(ABS(RRH-RHTOT).LT.0.1)RETURN
	TYPE 2,RHTOT,RST,RRH
	PAUSE
2	FORMAT(' TOTAL RHYTHM STAFF 0 = ',F6.3,
	1'    STAFF ',F2.0,' = ',F6.3)
	END


	SUBROUTINE ADJX
        COMMON /XRN/RN(1) /PTR/KWDS(1) /LIMIT/LIMIT,ITEM
        COMMON /RINP/P
	DIMENSION CLKSMT(3)
	DATA CLKSMT/3.0,17.0,18.0/
	X=P+2000.0
C THIS ROUTINE LOOKS AT ITEMS NOT YET SHIFTED BACK 2000.
	DO 5 JJ=1,3
	R1=CLKSMT(JJ)
	DO 1 K=1,ITEM
         L=KWDS(K)
         IF(RN(L+2).NE.0)GO TO 1
         IF(R1.NE.RN(L+1))GO TO 1
C NOW LOOK AT CLEFS, METER, AND KSIG
         R3=AMOD(RN(L+3),2000.0)
	 IF(R3.GT.P)GO TO 1
CC	 IF(R3.GT.X)GO TO 1
C LOOK ONLY BEFORE FIRST NOTE OR REST.
         DO 2 J=1,ITEM
           L=KWDS(J)
           IF(RN(L+2).EQ.0)GO TO 2
           IF(R1.NE.RN(L+1))GO TO 2
           RR3=RN(L+3)
  	   IF(RR3.GT.X.OR.RR3.LT.2000.0)GO TO 2
C LOOK ONLY BEFORE FIRST NOTE OR REST FOR NON-SHIFTED ITEMS.
	   IF(R1.NE.3.0)GO TO 3
	   IF(RN(L).GT.3.0)GO TO 2
C SKIP IF NOT REAL CLEF
3	   RN(L+3)=R3
C LINE UP ITEM WITH POS. OF SAME ITEM ON STAFF 0
2	 CONTINUE
1	CONTINUE
5	CONTINUE
	END

	SUBROUTINE COMBI(N,I,RST)
	COMMON R2,JA,CENTR,J2,RJ3,R4,R5
	COMMON /XRN/RN(1) /PTR/KWDS(1)
	1 /RINP/P(250),RHY(250),NO(1) /WHICH/SIZ(3),WHICH(3)
	EQUIVALENCE (BR,WHICH),(RKS,WHICH(2))
C BR=-0.2 RHY VAL FOR BARLINE, RKS=-0.4 KSIG
	L=1
	M=I
	R5=1999.0
	R2=RST
	X=0
100	IF(L.LT.I)GO TO 102
C NOW ADD THINGS FROM END OF UPPER STAFF.
	P(L)=P(M)
	RHY(L)=RHY(M)
	I=I+1
C UPDATE START OF M ARRAY
	GO TO 300
102	RL=RHY(L)
	RM=RHY(M)
	IF(ABS(RM-RL).GE.0.01)GO TO 1
C SKIP IF (ALMOST) NOT SAME RHY IN BOTH STAVES
300	M=M+1
	IF(M.GT.N)RETURN
200	L=L+1
	GO TO 100
1	IF(RM.LT.0)GO TO 4
C <0 = BAR, KSIG, METER
	IF(RL.LT.0)GO TO 5
	IF(AMOD(RM,RL).GT.0.01.AND.AMOD(RL,RM).GT.0.01)GO TO 101
C JUMP IF ONE RHY DOES NOT DIVIDE EVENLY INTO THE OTHER.
	X=RL-RM
	IF(X.LT.0)GO TO 2
	J=1
C GO INSERT POINT FROM M STAFF
	GO TO 10
2	RHY(M)=-X
C X IS NEG.   RESET UPPER RHY. TO DIFFERENCE
	P(M)=P(L+1)
C USE POSITION OF RHY ON STAFF 0
	GO TO 200
 
C NEXT FINDS NEXT RHYTHMIC MEETING OF THE PARTS.
101	A=RL
	B=RM
CURRENT RHYTHMIC VALS.
	D=RL
	E=RM
C USED TO FIND SHORTEST RHYTHMIC VAL.
	MM=M
	LL=L
C POINTERS FOR STEP AHEAD IN EACH LIST
	GO TO 99
C ADD UP RHY. VALS.
93	C=A-B
	IF(D.GT.RHY(LL))D=RHY(LL)
	IF(E.GT.RHY(MM))E=RHY(MM)
C FIND SHORTEST RHY VAL IN EACH STAFF
	IF(ABS(C).LT.0.01)GO TO 91
C JUMP IF TOTALS ARE THE SAME FOR EACH STAFF.
99	IF(A.GT.B)GO TO 92
C STEP AHEAD IN STAFF 0 NOW
	LL=LL+1
	A=A+RHY(LL)
	GO TO 93
92	MM=MM+1
C STEP AHEAD IN UPPER STAFF
	B=B+RHY(MM)
	GO TO 93
91	J=(MM-M)-(LL-L)
	IF(J)97,96,95
C MORE RHYS BELOW, SAME, ABOVE
97	L=LL+1
	M=MM+1
C MORE RHYS BELOW, SKIP ALL ABOVE UNTIL NEXT MATCHUP
98	IF(M.GT.N)RETURN
	GO TO 100
95	JM=MM-M+1
	N=N+J
	I=I+J
	DO 81 K=N,L+JM,-1
	RHY(K)=RHY(K-J)
81	P(K)=P(K-J)
C ABOVE OPENS SPACE FOR INSERT OF UPPER RHYS.
	M=M+J
C PUSH OVER POINTER TO UPPER STAFF DATA
	DO 80 K=L,LL+J
	RHY(K)=RHY(M)
	P(K)=P(M)
80	M=M+1
C INSERT DONE
	L=L+JM
	GO TO 98
96	IF(ABS(D-E).LE.0.01)GO TO 82
C NOW SAME NUM OF RHYS IN EACH STAFF
	IF(D.LT.E)GO TO 97
C JUMP IF SMALLEST RHY IS IN STF 0
	DO 90 K=L,LL
	RHY(K)=RHY(M)
	P(K)=P(M)
90	M=M+1
	GO TO 97

82	RL=RHY(L)
	RM=RHY(M)
	IF(RL.GT.RM)GO TO 84
C NOW USE ALL RHYS, SHORTEST IN BOTH, DIFF. PLACES
	RHY(M)=RM-RL
	L=L+1
	P(M)=P(L)
	IF(L.GT.LL)GO TO 100
C JUMP OUT IF UP NEXT RHYTHMIC MATCH POINT
	GO TO 82
84	X=RL-RM
	CALL INSPT(L,M,X,I,N,1)
C GO INSERT POINT FROM M STAFF
	IF(M.GT.N)RETURN
	IF(M.GT.MM)GO TO 100
C JUMP OUT IF UP NEXT RHYTHMIC MATCH POINT
	GO TO 82

4	IF(RL.LT.0)GO TO 6
C JUMP IF NON-NOTE ON BOTH STAVES
C NOW RM <0, RL >0, INSERT M DATA IN L ARRAY
	X=RL
	J=0
7	Y=-RM*20.0
C NOW MOVE ITEMS ON STAFF 0 TO RIGHT
	R4=P(M)
	R2=999.0
	CALL GETPTS(1)
	CALL MOVIT(RN,NO,R4,R5,Y,0)
	DO 11 K=L,I-1
C SHIFT POINTERS TO ITEMS OF STAFF 0
11	P(K)=P(K)+Y
C GO INSERT STUFF IN L ARRAY
	IF(X.EQ.0)GO TO 10
C NOW MOVE UPPER STAFF DATA BACK TO LEFT
	R2=RST
	CALL GETPTS(1)
	CALL MOVIT(RN,NO,R4,R5,-Y,0)
10	CALL INSPT(L,M,X,I,N,J)
C J IS FOR VARIOUS INSRT SITUATIONS
	IF(M.GT.N)RETURN
	GO TO 100
6	IF(RM.EQ.BR)GO TO 7
C BOTH NEG. BUT RM IS A BAR LINE.  GO INSERT IT.
	X=0
	IF(RL.NE.BR)GO TO 8
C NOW L IS BAR BUT NOT M.  MOVE M TO RIGHT
	Z=4.0
12	R4=P(M)
	R2=RST
	CALL GETPTS(1)
	CALL MOVIT(RN,NO,R4,R5,Z,0)
	DO 9 K=M,N
9	P(K)=P(K)+Z
C SHIFT THINGS IN M ARRAY (UPPER STAFF)
	GO TO 200
8	IF(RM.NE.RKS)GO TO 13
C ABOVE MEANS M IS A KSIG, L IS A METER
	X=RL
CC	J=1
	J=0
	GO TO 7
13	Z=8.0
C NOW L IS A KSIG, M IS A METER
	GO TO 12
5	Z=-RL*20.0
C L HAS BAR, KSIG, OR METER.  M HAS NOTE, ETC.
	GO TO 12
	END

	SUBROUTINE INSPT(L,M,X,I,N,J)
	COMMON /RINP/P(250),RHY(250)
C INSERTS SINGLE RHY FROM UPPER STAFF (M ARRAY)
10	N=N+1
	I=I+1
	DO 3 K=N,L+1,-1
	P(K)=P(K-1)
3	RHY(K)=RHY(K-1)
  	M=M+1
C M+1 BECAUSE ARRAY EXPANDED BY 1
	RHY(L)=RHY(M)
C INSERT NEW RHYTHM
	P(L+J)=P(M+J)
C J=0(INSERT BAR, ETC.) OR =1 (INSERT NOTE, REST)
	M=M+1
	L=L+1
	RHY(L)=X
	END

	SUBROUTINE LASTMV(I)
	COMMON R2,JA,CENTR,J2,RJ3,R4,R5 /STF/RSTFAC
	COMMON /XRN/RN(1) /PTR/KWDS(1) /WHICH/SIZ(3),WHICH(3)
	COMMON /RINP/P(250),RHY(250),NO(1)
CC	DATA SIZ/4.0,7.0,5.0/,WHICH/-0.2,-0.4,-0.3/
C SPACE REQUIREMENTS FOR BARLINE=4, KSIG=8, METER=5
	N=I-1
	J=0
	R2=999.0
	R4=P(1)
	R5=5000.0
	CALL GETPTS(1)
	CALL MOVIT(RN,NO,R4,R5,2000.0,0)
C MOVE ALL OUT TO RIGHT AGAIN
	A=P(1)
10	J=J+1
	RH=RHY(J)
	IF(RH.GT.0)GO TO 13
	ENDI=X
	IF(RH.EQ.WHICH(1))BAR=X
C FIND LAST BAR AND LAST KSIG OR METER.  USE PREVIOUS POS.
	DO 11 K=1,3
11	IF(RH.EQ.WHICH(K))X=SIZ(K)*RSTFAC+A
C STAFF 0 SIZE DETERMINES ACTUAL SPACE FOR BAR, KSIG, METER.
	GO TO 12
13	X=FIB(RH)+A
C GET FIBONOCCI SPACE TO NEXT NOTE OR REST
12	CALL MOVIT(RN,NO,P(J)+2000.0,P(J+1)+2000.01,A,X+0.01)
C MOVE BACK INTO FINAL POSITION.  (.01 NEEDED FOR ROUND OFF PROB.)
	A=X
C SET NEXT POSITION POINTER
	IF(J.LT.N)GO TO 10
C NOW FIND LAST BAR AND LAST KSIG AND/OR METER
	R4=0
	CALL GETPTS(1)
	CALL MOVIT(RN,NO,BAR+0.01,2000.0,200.0,0)
C MOVE STUFF (IF ANY) BEYOND BARLINE 200 TO RIGHT
4	CALL MOVIT(RN,NO,P(1),BAR+0.01,P(1),200.0)
C P(1)=POS. OF 1ST NOTE, ETC., STF 0.  MOVES ALL INTO GIVEN LIMITS.
	IF(BAR.EQ.ENDI)GO TO 15
	X=2.5
	IF(RHY(N-1).NE.WHICH(1))X=13.0
C IF PREVIOUS ITEM IS NOT BAR THEN IT MUST BE KSIG - MORE SPACE NEEDED.
	CALL MOVIT(RN,NO,200.1,2000.0,RSTFAC*X-ENDI,0)
C MOVE BACK ITEMS BEYOND LAST BARLINE.
15	CALL MOVIT(RN,NO,2000.0,5000.0,201.0,201.0)
CATCH END POINTS OF SLURS, ETC.  MOVE THEM ALL BACK
C****
C ADD HERE ROUTINE TO SET KSIG AND METER BEYOND 200 TO EXACT POSITION.
	END

	FUNCTION FIB(VAL)
	DATA AL/0.5849624/
   	FIB=14.0*EXP(ALOG(VAL)*AL)
C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5))  NOT FIBBONACI (1.618)
	END